home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
tool_inc.zip
/
ANSICOLR.INC
< prev
next >
Wrap
Text File
|
1990-02-27
|
3KB
|
101 lines
(*
* Copyright 1987, 1989 Samuel H. Smith; All rights reserved
*
* This is a component of the ProDoor System.
* Do not distribute modified versions without my permission.
* Do not remove or alter this notice or any other copyright notice.
* If you use this in your own program you must distribute source code.
* Do not use any of this in a commercial product.
*
*)
(*
* Generation of ANSI codes for color
*
*)
procedure position(x,y: byte);
{position cursor}
begin
_disp(#27'[' + itoa(y) + ';' + itoa(x) + 'f');
end;
procedure clear_screen;
{easee screen in current color}
begin
_disp(#27'[2J');
end;
procedure clear_eol;
{clear to end of line}
begin
_disp(#27'[K');
end;
(* ------------------------------------------------------------ *)
function code_color(control: integer): string20;
{form an ansi color command}
var
newcolor: string20;
begin
if graphics and (not message_capture) then
newcolor := #27'[' + ansi_colors[control] + 'm'
else
newcolor := '';
{ if newcolor = ansi_ccolor then
code_color := ''
else }
begin
ansi_ccolor := newcolor;
code_color := newcolor;
end;
end;
(* ------------------------------------------------------------ *)
{color selection macros}
function aRED: string20; begin aRED := code_color(ansi_RED); end;
function aGREEN: string20; begin aGREEN := code_color(ansi_GREEN); end;
function aYELLOW: string20; begin aYELLOW := code_color(ansi_YELLOW); end;
function aBLUE: string20; begin aBLUE := code_color(ansi_BLUE); end;
function aMAGENTA: string20; begin aMAGENTA := code_color(ansi_MAGENTA); end;
function aCYAN: string20; begin aCYAN := code_color(ansi_CYAN); end;
function aWHITE: string20; begin aWHITE := code_color(ansi_WHITE); end;
function aGRAY: string20; begin aGRAY := code_color(ansi_GRAY); end;
procedure adRED(m: string); begin _disp(aRED); pdisp(m); end;
procedure adGREEN(m: string); begin _disp(aGREEN); pdisp(m); end;
procedure adYELLOW(m: string); begin _disp(aYELLOW); pdisp(m); end;
procedure adBLUE(m: string); begin _disp(aBLUE); pdisp(m); end;
procedure adMAGENTA(m: string);begin _disp(aMAGENTA); pdisp(m); end;
procedure adCYAN(m: string); begin _disp(aCYAN); pdisp(m); end;
procedure adWHITE(m: string); begin _disp(aWHITE); pdisp(m); end;
procedure adGRAY(m: string); begin _disp(aGRAY); pdisp(m); end;
procedure default_color; begin _disp(code_color(ansi_default)); end;
(* ------------------------------------------------------------ *)
procedure load_color_constants(name: string65);
{load a new set of color constants}
var
fd: text;
i: integer;
begin
if not dos_exists(name) then
exit;
assignText(fd,name);
reset(fd);
readln(fd);
for i := 1 to 8 do
readln(fd,ansi_colors[i]);
close(fd);
end;